How Would You Survive?/How Would You Survive (1995)(Grolier)[Mac-PC].iso/mac/EINDEX.DIR/00707_Script_aTopicMenu

Text File | 1995-09-06 | 8KB | 207 lines

--òò aTopicMenu
--òò This object represents an entry in the Alabetical Index System
--òò In otherwords we need to create one of these objects per
--òò Letter in the alphabet. This object in turn manages a sub-menu
--òò of entries associated with the Letter. Each sub-menu entry
--òò manages a list of links to locations in the subject screens
--òò of the title.
property pHilightCast, pSprite , pDefaultCast , pRange┬
       , pRefLink , pLeftEntries, pRightEntries , pEndOFLine  , pLineSpace
on birth me , startCast , stopCast , theSprite , theDefaultCast┬
            , functionCast ,iconCast  ,numLeftEntries, newRightEntries
  setTopicMenuParameters me , numLeftEntries, newRightEntries
  set pLineSpace = 25
  set pDefaultCast = theDefaultCast
  if (startCast) then
    set pHilightCast = startCast
  else
    set pHilightCast = pDefaultCast
  end if
  set pRange = stopCast - startCast + 1
  set pSprite = theSprite

  set refCountMax = numLeftEntries + newRightEntries
  set refCount = 1
  set pRefLink = []
  set pEndOFLine = FALSE
  set refLinkClass = the number of cast "aRefLink"
  repeat while (refCount <= refCountMax)
    setAt( pRefLink ,refCount, birth (script refLinkClass, iconCast + refCount - 1 ,40┬
        ,1 ,functionCast))
    set refCount = refCount + 1
  end repeat

  return me
end

on setTopicMenuParameters me , numLeftEntries, newRightEntries
  set pRightEntries = newRightEntries
  set pLeftEntries = numLeftEntries
end

on setTopicMenu me
  if (pSprite > 0) then
    set the castNum of sprite pSprite = pHilightCast
  else
    set the castNum of sprite pSprite = pDefaultCast
  end if
end

on setTopicHiLight me , theOffset
  if (pRightEntries and rollover(41)) then
    -- right entry processing
    set topicOffset =  theOffset/pLineSpace
    if (topicOffset <= pRange) then
      set the castNum of sprite pSprite = pHilightCast + topicOffset - 1 + pLeftEntries
    end if
  else
    -- left entry processing
    set topicOffset =  theOffset/pLineSpace
    if (topicOffset <= pRange) then
      set the castNum of sprite pSprite = pHilightCast + topicOffset - 1
    end if
  end if
end

--òò Ref Link handlers
on selectTopicFromMenu me,theOffset
  if (theOffset > 62) then
    set theOffset = theOffset - 62
    set topicOffset =  (theOffset/pLineSpace) + 1
    --put theOffset , topicOffset
    if (pRightEntries and rollover(41)) then
      -- right entry processing
      if (topicOffset > 0 and topicOffset <= pRightEntries) then
        set thisLink = getAt(pRefLink,topicOffset + pLeftEntries)
      end if
    else
      -- left entry processing
      if (topicOffset > 0 and topicOffset <= pLeftEntries) then
        set thisLink = getAt(pRefLink,topicOffset)
      end if
    end if
    showRefLinkIcon(thisLink)
  end if
end

on clickRefLink me , theOffset , horzPos , vertPos
  set pEndOFLine = FALSE
  --put vertPos ,horzPos
  --set thisLink = getAt(pRefLink,1)
  --clickRefLink(thisLink , theOffset)
  set thisCast = the castNum of sprite 40
  set thisStr = the scriptText of cast thisCast
  set thisLength = length(thisStr)
  set strCount = 3
  set commaPos1 = getCommaPos (me, thisStr , strCount , thisLength)
  set commaPos2 = getCommaPos (me, thisStr , commaPos1 + 1, thisLength)
  set commaPos3 = getCommaPos (me, thisStr , commaPos2 + 1, thisLength)
  set commaPos4 = getCommaPos (me, thisStr , commaPos3 + 1, thisLength)
  if (getRecPos (me, thisStr , 3 , commaPos1 ) = 0) then
    -- this is simple (one ref) reference
    --beep 1
    --put 1
    do getFunctionStr (me, thisStr , commaPos4 , thisLength )
  else
    -- test if click is inside of rect
    set pEndOFLine = FALSE
    set startStr = 2
    set beepCount = 1
    repeat while (pEndOFLine = FALSE)
      --testClick me,commaPos1,commaPos2,commaPos3,commaPos4 , ┬
          thisStr , thisLength , horzPos , vertPos
      if (testClick(me,startStr,commaPos1,commaPos2,commaPos3 ┬
                 , thisStr , thisLength, horzPos , vertPos)) then
        -- get function
        set pEndOFLine = TRUE
        --beep beepCount
        --put beepCount
        do getFunctionStr (me, thisStr , commaPos4 , thisLength )
      else
        -- move past function
        set semiColPos = getSemiCol  (me, thisStr , commaPos4 + 1 , thisLength)
        set commaPos1 = getCommaPos (me, thisStr , semiColPos + 1 , thisLength)
        set commaPos2 = getCommaPos (me, thisStr , commaPos1 + 1, thisLength)
        set commaPos3 = getCommaPos (me, thisStr , commaPos2 + 1, thisLength)
        set commaPos4 = getCommaPos (me, thisStr , commaPos3 + 1, thisLength)
        set startStr = semiColPos
        set beepCount = beepCount + 1
      end if
    end repeat
  end if
end

on clearRefLinkIcon me
  if (not(pRefLink = []) ) then
    set thisLink = getAt(pRefLink,1)
    clearRefLinkIcon(thisLink)
  end if
end

on getSemiCol  me , thisStr , strCount , thisLength
  --òò This handler returns the position of the next comma, or the end of the string
  set thisChar = chars(thisStr,strCount,strCount)
  if (thisChar = "%") then set pEndOFLine = TRUE
  repeat while (not(thisChar = ";") and strCount < thisLength)
    set strCount = strCount + 1
    set thisChar = chars(thisStr,strCount,strCount)
    if (thisChar = "%") then set pEndOFLine = TRUE
  end repeat
  return strCount
end

on getCommaPos me , thisStr , strCount , thisLength
  --òò This handler returns the position of the next comma, or the end of the string
  set thisChar = chars(thisStr,strCount,strCount)
  if (thisChar = "%") then set pEndOFLine = TRUE
  repeat while (not(thisChar = ",") and strCount < thisLength)
    set strCount = strCount + 1
    set thisChar = chars(thisStr,strCount,strCount)
    if (thisChar = "%") then set pEndOFLine = TRUE
  end repeat
  return strCount
end

on getRecPos me , thisStr , strCount , thisLength
  set intCount = strCount
  set thisChar = chars(thisStr,strCount,strCount)
  repeat while (not(thisChar = ",") and strCount < thisLength)
    set strCount = strCount + 1
    set thisChar = chars(thisStr,strCount,strCount)
  end repeat
  return (chars (thisStr , intCount , strCount - 1))
end

on getFunctionStr me, thisStr , strCount , thisLength
  set intCount = strCount
  set thisChar = chars(thisStr,strCount,strCount)
  repeat while (not(thisChar = ";") and strCount < thisLength)
    set strCount = strCount + 1
    set thisChar = chars(thisStr,strCount,strCount)
  end repeat
  return (chars (thisStr , intCount + 1 , strCount - 1))
end

on testClick me,commaPos1,commaPos2,commaPos3,commaPos4 , thisStr , thisLength , horzPos , vertPos
  set topPos = getRecPos (me , thisStr , commaPos1 + 1 , thisLength)
  set leftPos =  getRecPos (me , thisStr , commaPos2 + 1 , thisLength)
  set bottomPos =  getRecPos (me , thisStr , commaPos3 + 1 , thisLength)
  set rightPos =  getRecPos (me , thisStr , commaPos4 + 1 , thisLength)
  --  put "T"&&topPos
  --  put "L"&&leftPos
  --  put "B"&&bottomPos
  --  put "R"&&rightPos&&RETURN
  if ((topPos < vertPos) and (bottomPos > vertPos) and ┬
         (leftPos < horzPos) and (rightPos > horzPos)) then
    -- we have a click within this rect
    return TRUE
  else
    return FALSE
  end if
end

on reset me
  --put pSprite, pDefaultCast
  set the castNum of sprite pSprite = pDefaultCast
  clearRefLinkIcon me
end